source("code/setup.R")

# Data prep
WB_Gcosinor <- read_rds("output/WB_G-cosinor.rds")
WB_Scosinor <- read_rds("output/WB_S-cosinor.rds")
# Gather results
ROI_Gcosinor <- readRDS("output/ROI_G-cosinor.rds")
ROI_Scosinor <- readRDS("output/ROI_S-cosinor.rds") |> unnest(bsc)

plotdf <-
  ROI_Scosinor |>
  # Calc summary stats
  group_by(measure,subject) |> 
  mutate(sub_resultant=acro2complex(acrophase) |> mean() |> abs()) |> 
  inner_join(WB_Scosinor |> select(measure,subject,sub_macro=acrophase)) |> 
  group_by(measure,roi) |> 
  rename(p_sub_cos = pvalue) |> 
  group_by(measure) |> 
  mutate(p_rank=-rank(p_sub_cos)/length(p_sub_cos)) |> 
  # Join to rest
    group_by(measure,roi) |> 
    nest(by_visit = c(-measure,-roi)) |>
    inner_join(ROI_Gcosinor |> 
                select(measure, roi, 
                       p_gcos_cos=pvalue,
                       gcos_acro = acrophase, acro_u, acro_l,
                       gcos_amp = amplitude,
                       q_gcos_cos = qvalue,
                       amp_u,
                       amp_l,
                       gcos_mesor = MESOR))

# Ordering ROIs and adjusting acrophases
tmpdf <-
    plotdf |>
    unnest(by_visit) |>
    ungroup() |> 
    group_by(measure) |> 
    nest() |> 
    mutate(tmp=map(data,function(x){
        x |> 
            mutate(roif=factor(roi)) |>
            mutate(subject=factor(subject)) |> 
            ungroup() |> 
            arrange(p_gcos_cos,(sub_macro)%%24) |> 
            mutate(roif=fct_inorder(roif)) |> 
            mutate(subject=fct_inorder(subject)) |> 
            mutate(subjectn=as.numeric(subject)) |> 
            mutate(roin=as.numeric(roif)) |> 
            mutate(roif2=fct_inorder(roif)) |> 
            mutate(roin2=as.numeric(roif2))
    })) |> unnest(tmp) |> 
    ungroup() |> 
    arrange(measure) |> 
    mutate(roin_comb=factor(paste(measure,roin))) |> 
    mutate(roin_comb=fct_inorder(roin_comb))

Applying some preprocessing to the data:

  • Ordering ROIs and subjects
  • Adjusting acrophases to a 9-33 timescale

Figure 3a: Subject vs Acrophase

Figure S3a: Tick plot

# https://github.com/dgrtwo/drlib/blob/master/R/reorder_within.R
# For applying unique orderings within each facet while retaining
# the original labels
reorder_within <- function(x, by, within, fun = mean, sep = "___", ...) {
  new_x <- paste(x, within, sep = sep)
  stats::reorder(new_x, by, FUN = fun)
}
scale_y_reordered <- function(..., sep = "___") {
  reg <- paste0(sep, ".+$")
  ggplot2::scale_y_discrete(labels = function(x) gsub(reg, "", x), ...)
}
scale_x_reordered <- function(..., sep = "___") {
  reg <- paste0(sep, ".+$")
  ggplot2::scale_x_discrete(labels = function(x) gsub(reg, "", x), ...)
}

binsize=0.1
cuts <- seq(0,24,binsize)
bins <- levels(cut(1,cuts))

f3a_sub_act <-
    tmpdf |>
  mutate(measure=recode(measure, !!!int2extlab)) |> 
  group_by(measure,subject,sub_macro) |> 
    summarize(acro_cnt = table(cut(acrophase,cuts)) |> enframe()) |> 
    unnest(acro_cnt) |> 
    mutate(tod=cuts[which(bins == name)]+binsize/2) |> 
    mutate(value=as.numeric(value)/sum(value)) |>
    filter(value!=0) |> 
    ggplot(aes(reorder_within(subject, (sub_macro)%%24, measure),tod))+
    night_recty_early()+
    night_recty()+
    scale_x_reordered()+
    xlab("Subject")+ylab("ROI S-cosinor Acrophase")+
  geom_tile(fill="black",width=0.5,height=binsize)+
    coord_flip()+
    facet_grid(measure~.,scales="free")+ #,space = "free")
  geom_point(data=WB_Scosinor |> 
               mutate(measure=recode(measure, !!!int2extlab)),
             aes(reorder_within(subject,(acrophase)%%24, measure),
                 acrophase,group=NA),size=1,alpha=0.7,color=colors$ssc,
             position=position_nudge(x = 0.3, y = 0))+
    scale_y_continuous(limits=c(0,24),breaks=seq(0,24,3))+
  theme_condense()
f3a_sub_act

Figure 3a: Subset for main fig

binsize=0.1
cuts <- seq(0,24,binsize)
bins <- levels(cut(1,cuts))

# (Partial) Source Data
write_csv(WB_Gcosinor |> 
  filter(measure %in% c("cbf","gm_md","md")) |> 
  mutate(measure=recode(measure, !!!int2extlab)) |> 
  select(measure,acrophase),"output/source_data/Figure_3a_partial.csv")

f3a_sub_act_ss <-
    tmpdf |> filter(measure %in% c("cbf","gm_md","md","qt1")) |>
  # Keep measure ordering
  mutate(measure=recode(measure, !!!int2extlab)) |> 
  group_by(measure,subject,sub_macro) |> 
    summarize(acro_cnt = table(cut(acrophase,cuts)) |> enframe()) |> 
    unnest(acro_cnt) |> 
    mutate(tod=cuts[which(bins == name)]+binsize/2) |> 
  # get acrobins with data
    mutate(value=as.numeric(value)/sum(value)) |>
    filter(value!=0) |> 
    ggplot(aes(reorder_within(subject, (sub_macro)%%24, measure),tod))+
    night_recty_early()+
  night_recty()+
    scale_x_reordered()+
    xlab("Subject")+ylab("ROI S-cosinor Acrophase")+
  #Data
  geom_point(data=WB_Scosinor |> 
               filter(measure %in% c("cbf","gm_md","md","qt1")) |> 
               mutate(measure=recode(measure, !!!int2extlab)),
             aes(reorder_within(subject,(acrophase)%%24, measure),
                 acrophase,group=NA),size=1.5,alpha=0.7,color=colors$ssc,
             position=position_nudge(x = 0.3, y = 0))+
  geom_tile(fill="black",width=0.5,height=binsize)+
  coord_flip(ylim = c(0,24))+
    facet_grid(measure~.,scales="free")+ #,space = "free")
  geom_hline(data=WB_Gcosinor |> 
               filter(measure %in% c("cbf","gm_md","md")) |> 
               mutate(measure=recode(measure, !!!int2extlab)),
             aes(yintercept=acrophase,group=NA),
             size=1,color=colors$gcos_sig)+
    scale_y_continuous(breaks=seq(0,24,3))+
  theme_condense()+
  theme(axis.text=element_text(size=8))
f3a_sub_act_ss

AcroVariance Summaries

Figure S3b: rho within-subject summary

rhosum_p <-
    plotdf |> 
  mutate(measure=recode(measure, !!!int2extlab)) |> 
    unnest(by_visit) |>
    ungroup() |> 
    select(measure,subject,sub_macro,sub_resultant) |> unique() |> 
    ggplot(aes(reorder_within(subject, (sub_macro)%%24, measure),
               1-sub_resultant))+
    geom_col(width = 0.5,fill="#C26179")+
    coord_flip()+
    xlab(NULL)+
    ylab("Acrophase Variance")+
    scale_x_reordered()+
  scale_y_continuous(breaks=c(0,0.5,1))+
    facet_grid(measure~.,scales="free")+
    theme_condense()
rhosum_p

Figure 3a.2: rho within-subject summary (subset)

rhosum_ss_p <-
    plotdf |> 
    filter(measure %in% c("cbf","gm_md","md","qt1")) |>   
    unnest(by_visit) |>
    ungroup() |> 
    select(measure,subject,sub_macro,sub_resultant) |> unique() |> 
    ggplot(aes(reorder_within(subject, (sub_macro)%%24, measure),
               1-sub_resultant))+
    geom_col(width = 0.5,fill="#C26179")+
    coord_flip()+
    xlab(NULL)+
    ylab(expression(1-abs(rho[within-subject])))+
    scale_x_reordered()+
  scale_y_continuous(breaks=c(0,0.5,1))+
    facet_grid(int2extlab[measure]~.,scales="free")+ #,space = "free")+
    theme_condense()
rhosum_ss_p

Figure S3c: ROI vs Acro

For supplemental

binsize=0.4
cuts <- seq(0,24,binsize)
bins <- levels(cut(1,cuts))

# (Partial) Source Data
figS3cSD <-
  tmpdf |>
  mutate(measure=recode(measure, !!!int2extlab)) |> 
  filter(q_gcos_cos<0.05) |>
  select(roin,roi,measure,tod=gcos_acro) |>
  mutate(subject="Cohort") |> unique()
write_csv(figS3cSD,"output/source_data/Figure_S3c_partial.csv")

p_roiact<-
  tmpdf |>
  group_by(measure,roin) |> 
  mutate(measure=recode(measure, !!!int2extlab)) |> 
    summarize(acro_cnt = table(cut(acrophase,cuts)) |> enframe()) |> 
    unnest(acro_cnt) |> 
    mutate(tod=cuts[which(bins == name)]+binsize/2) |> 
    mutate(value=as.numeric(value)/sum(value)) |> 
    filter(value!=0) |> 
    ggplot(aes(-roin,tod))+
    night_recty_early()+
    scale_x_reordered()+
    ylab("ROI S(G)-cosinor Acrophase")+
    xlab("ROI ranked by G-cosinor p")+
  geom_tile(fill="black",width=1,height=binsize)+
    coord_flip()+
    facet_grid(measure~.,scales="free")+ #,space = "free")
  geom_point(size=0.5,data=figS3cSD,color="blue",alpha=0.7)+
    scale_y_continuous(limits=c(0,24),breaks=seq(0,24,3))+
  theme_condense()
p_roiact

Polar scatter G-cosinor

In main text, maximal acrophase differences are reported alongside the span of CIs

plotdf |> 
  inner_join(WB_Gcosinor |> select(measure,acrophase),by="measure") |> 
  filter(q_gcos_cos<0.05) |> 
  group_by(measure) |> 
  summarize(circdist(gcos_acro,acrophase) |> abs() |> max())
# A tibble: 3 × 2
  measure `max(abs(circdist(gcos_acro, acrophase)))`
  <chr>                                        <dbl>
1 cbf                                           2.90
2 gm_md                                         3.76
3 md                                            5.12
WB_Gcosinor |>
  filter(pvalue<0.05) |> 
  mutate(span=circdist(acro_u,acro_l)) |> 
  select(measure,span)
# A tibble: 4 × 2
# Groups:   measure [4]
  measure  span
  <chr>   <dbl>
1 cbf      3.08
2 fa       5.79
3 gm_md    4.13
4 md       3.52

Figure 3c: Main

predat <- plotdf |>
    filter(measure %in% c("cbf","gm_md","md","qt1")) |> 
    group_by(measure) |> 
    arrange(measure) |> 
    mutate(nsig=sum(q_gcos_cos<0.05),n=n())

## Source Data
# ROI data
fig3cSD <- 
  predat |>
  ungroup() |>
  mutate(measure=int2extlab[measure]) |> 
  select(measure, nsig, n, p_gcos_cos,q_gcos_cos,gcos_acro)
write_csv(fig3cSD, "output/source_data/Figure_3c_part1.csv")
# WB data
fig3cSD2 <- 
  WB_Gcosinor |> 
  right_join(predat |> 
               select(measure,nsig,n) |> 
               unique()) |>
  filter(pvalue<0.05) |> 
  ungroup() |> 
  mutate(measure=int2extlab[measure]) |> 
  select(measure,nsig,n,pvalue,acrophase,acro_l,acro_u)
write_csv(fig3cSD2,"output/source_data/Figure_3c_part2.csv")


gcrose_ss_p <-
  fig3cSD |> 
  mutate(label=fct_inorder(paste0(measure," (",nsig,"/",n,")"))) |> 
    ggplot(aes(gcos_acro,-log10(p_gcos_cos)))+
    night_rect_early()+
    geom_rect(xmin=-1,xmax=25,ymin=-2,ymax=0,fill="white",color=NA)+
    annotate(geom="segment",x=seq(0,24,3),y=4,yend=0,xend=seq(0,24,3),
             color="grey90",size=0.3)+
  geom_hline(yintercept = 0,color="grey50")+
    geom_hline(yintercept = c(1,2,3,4),color="grey90",size=0.5)+
    coord_polar()+
    scale_y_continuous(limits = c(-2,NA),breaks=c(0,1,2,3,4))+
    scale_x_continuous(limits=c(0,24),breaks=seq(0,24,3))+
    xlab("ROI G-cosinor Acrophase")+
    ylab(expression(log[10](p[G])))+
    # Making WM-MD larger since fewer ROIs
  # unused
    geom_point(aes(size=1/n,fill=q_gcos_cos<0.05),alpha=0.7,
      shape=21, stroke=0,  
      color="transparent"
    )+
    scale_size_continuous(range = c(1,1),guide='none')+
  theme(panel.border=element_blank())+
    theme(panel.grid=element_blank())+
    geom_point(data=fig3cSD2 |> 
                    mutate(label=fct_inorder(paste0(measure," (",nsig,"/",n,")"))),  
               aes(acrophase,5,color=pvalue<0.05),size=2)+
    geom_errorbar(data=fig3cSD2 |> mutate(label=fct_inorder(paste0(measure," (",nsig,"/",n,")"))),  
               aes(acrophase,5,xmin=acro_l,xmax=acro_u,
                color=pvalue<0.05),size=1.5)+
    scale_fill_manual(labels=c(bquote(q[G]*"<0.05"),
                                bquote(q[G]*">0.05")),
                                values = c("TRUE"=colors$gcos_sig,
                                  "FALSE"="black"),guide="none")+
    scale_color_manual(labels=c(bquote(q[G]*"<0.05"),
                                bquote(q[G]*">0.05")),
                                values = c("TRUE"=colors$gcos_sig,
                                  "FALSE"="black"),guide='none')+
  # Remove for post
  # guides(color=guide_legend(title=""))+
    facet_grid(label~.)+theme_condense()
gcrose_ss_p

Figure S3d: Sro3

# Copied from main fig code and commented out
predat <- plotdf |>
    # filter(measure %in% c("cbf","gm_md","md","qt1")) |> 
    group_by(measure) |> 
    arrange(measure) |> 
    mutate(nsig=sum(q_gcos_cos<0.05),n=n())

## Source Data
# ROI data
figS3dSD <- 
  predat |>
  ungroup() |> 
  mutate(measure=int2extlab[measure]) |> 
  select(measure,nsig,n, p_gcos_cos,n, q_gcos_cos,gcos_acro)
write_csv(figS3dSD,"output/source_data/Figure_S3d_part1.csv")
# WB data
figS3dSD2 <- 
  WB_Gcosinor |> 
  right_join(predat |> 
               select(measure,n,nsig) |> 
               unique()) |>
  filter(pvalue<0.05) |>
  ungroup() |> 
  mutate(measure=int2extlab[measure]) |> 
  select(measure,nsig,n,acrophase,acro_l,acro_u,pvalue)
write_csv(figS3dSD2,"output/source_data/Figure_S3d_part2.csv")


gcrose_p <-
    figS3dSD |> 
    mutate(label=fct_inorder(paste0(measure," (",nsig,"/",n,")"))) |> 
    ggplot(aes(gcos_acro,-log10(p_gcos_cos)))+
    night_rect_early()+
    geom_rect(xmin=-1,xmax=25,ymin=-2,ymax=0,fill="white",color=NA)+
    annotate(geom="segment",x=seq(0,24,3),y=4,yend=0,xend=seq(0,24,3),
             color="grey90",size=0.3)+
  geom_hline(yintercept = 0,color="grey50")+
    geom_hline(yintercept = c(1,2,3,4),color="grey90",size=0.5)+
    coord_polar()+
    scale_y_continuous(limits = c(-2,NA),breaks=c(0,1,2,3,4))+
    scale_x_continuous(limits=c(0,24),breaks=seq(0,24,3))+
    xlab("ROI G-cosinor Acrophase")+
    ylab(expression(log[10](p[G])))+
    # Making WM-MD larger since fewer ROIs
  # unused
    geom_point(aes(size=1/n,fill=q_gcos_cos<0.05),alpha=0.7,
      shape=21, stroke=0,  
      color="transparent"
    )+
    scale_size_continuous(range = c(1,1),guide='none')+
  theme(panel.border=element_blank())+
    theme(panel.grid=element_blank())+
    geom_point(data=figS3dSD2 |> 
                    mutate(label=fct_inorder(paste0(measure," (",nsig,"/",n,")"))),  
               aes(acrophase,5,color=pvalue<0.05),size=1.5)+
    geom_errorbar(data=figS3dSD2 |>     mutate(label=fct_inorder(paste0(measure," (",nsig,"/",n,")"))),  
               aes(acrophase,5,xmin=acro_l,xmax=acro_u,
                color=pvalue<0.05),size=1)+
    scale_fill_manual(labels=c(bquote(q[G]*"<0.05"),
                                bquote(q[G]*">0.05")),
                                values = c("TRUE"=colors$gcos_sig,
                                  "FALSE"="black"),guide="none")+
    scale_color_manual(labels=c(bquote(q[G]*"<0.05"),
                                bquote(q[G]*">0.05")),
                                values = c("TRUE"=colors$gcos_sig,
                                  "FALSE"="black"),guide='none')+
  guides(color=guide_legend(title=""))+
    facet_grid(label~.)+theme_condense()
gcrose_p

Brain images

Glasser

library(ggsegGlasser)
library(ggseg)
meta <- get_glasser_spatial_meta()

meta[!(meta$region %in% glasser$data$region),]
# A tibble: 0 × 15
# … with 15 variables: regionName <chr>, regionLongName <chr>, regionIdLabel <chr>, LR <chr>,
#   region <chr>, Lobe <chr>, cortex <chr>, regionID <dbl>, Cortex_ID <dbl>, x-cog <dbl>, y-cog <dbl>,
#   z-cog <dbl>, volmm <dbl>, roi <chr>, hemi <chr>
glasser$data[!(glasser$data$region %in% meta$region),]
Simple feature collection with 2 features and 4 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 438.8319 ymin: 6.778569 xmax: 961.9789 ymax: 126.6569
CRS:           NA
# ggseg atlas
  hemi  region side   label                                                                      geometry
  <chr> <chr>  <chr>  <chr>                                                                <MULTIPOLYGON>
1 left  <NA>   medial lh_??? (((528.977 123.0814, 523.8317 121.4616, 516.5314 122.7013, 510.249 122.6745…
2 right <NA>   medial rh_??? (((868.243 126.2886, 864.9204 122.4204, 861.5556 122.3028, 857.8689 123.743…
full_join(ROI_Gcosinor |> filter(measure=="cbf"),
          meta |> select(region,hemi,roi)) |>
  filter(!is.na(qvalue) & !is.na(region)) |> pull(roi)
  [1] "L_V1_ROI"     "L_MST_ROI"    "L_V6_ROI"     "L_V2_ROI"     "L_V3_ROI"     "L_V4_ROI"    
  [7] "L_V8_ROI"     "L_4_ROI"      "L_3b_ROI"     "L_FEF_ROI"    "L_PEF_ROI"    "L_55b_ROI"   
 [13] "L_V3A_ROI"    "L_RSC_ROI"    "L_POS2_ROI"   "L_V7_ROI"     "L_IPS1_ROI"   "L_FFC_ROI"   
 [19] "L_V3B_ROI"    "L_LO1_ROI"    "L_LO2_ROI"    "L_PIT_ROI"    "L_MT_ROI"     "L_A1_ROI"    
 [25] "L_PSL_ROI"    "L_SFL_ROI"    "L_PCV_ROI"    "L_STV_ROI"    "L_7Pm_ROI"    "L_7m_ROI"    
 [31] "L_POS1_ROI"   "L_23d_ROI"    "L_v23ab_ROI"  "L_d23ab_ROI"  "L_31pv_ROI"   "L_5m_ROI"    
 [37] "L_5mv_ROI"    "L_23c_ROI"    "L_5L_ROI"     "L_24dd_ROI"   "L_24dv_ROI"   "L_7AL_ROI"   
 [43] "L_SCEF_ROI"   "L_6ma_ROI"    "L_7Am_ROI"    "L_7PL_ROI"    "L_7PC_ROI"    "L_LIPv_ROI"  
 [49] "L_VIP_ROI"    "L_MIP_ROI"    "L_1_ROI"      "L_2_ROI"      "L_3a_ROI"     "L_6d_ROI"    
 [55] "L_6mp_ROI"    "L_6v_ROI"     "L_p24pr_ROI"  "L_33pr_ROI"   "L_a24pr_ROI"  "L_p32pr_ROI" 
 [61] "L_a24_ROI"    "L_d32_ROI"    "L_8BM_ROI"    "L_p32_ROI"    "L_10r_ROI"    "L_47m_ROI"   
 [67] "L_8Av_ROI"    "L_8Ad_ROI"    "L_9m_ROI"     "L_8BL_ROI"    "L_9p_ROI"     "L_10d_ROI"   
 [73] "L_8C_ROI"     "L_44_ROI"     "L_45_ROI"     "L_47l_ROI"    "L_a47r_ROI"   "L_6r_ROI"    
 [79] "L_IFJa_ROI"   "L_IFJp_ROI"   "L_IFSp_ROI"   "L_IFSa_ROI"   "L_p9-46v_ROI" "L_46_ROI"    
 [85] "L_a9-46v_ROI" "L_9-46d_ROI"  "L_9a_ROI"     "L_10v_ROI"    "L_a10p_ROI"   "L_10pp_ROI"  
 [91] "L_11l_ROI"    "L_13l_ROI"    "L_OFC_ROI"    "L_47s_ROI"    "L_LIPd_ROI"   "L_6a_ROI"    
 [97] "L_i6-8_ROI"   "L_s6-8_ROI"   "L_43_ROI"     "L_OP4_ROI"    "L_OP1_ROI"    "L_OP2-3_ROI" 
[103] "L_52_ROI"     "L_RI_ROI"     "L_PFcm_ROI"   "L_PoI2_ROI"   "L_TA2_ROI"    "L_FOP4_ROI"  
[109] "L_MI_ROI"     "L_Pir_ROI"    "L_AVI_ROI"    "L_AAIC_ROI"   "L_FOP1_ROI"   "L_FOP3_ROI"  
[115] "L_FOP2_ROI"   "L_PFt_ROI"    "L_AIP_ROI"    "L_EC_ROI"     "L_PreS_ROI"   "L_ProS_ROI"  
[121] "L_PeEc_ROI"   "L_STGa_ROI"   "L_PBelt_ROI"  "L_A5_ROI"     "L_PHA1_ROI"   "L_PHA3_ROI"  
[127] "L_STSda_ROI"  "L_STSdp_ROI"  "L_STSvp_ROI"  "L_TGd_ROI"    "L_TE1a_ROI"   "L_TE1p_ROI"  
[133] "L_TE2a_ROI"   "L_TF_ROI"     "L_TE2p_ROI"   "L_PHT_ROI"    "L_PH_ROI"     "L_TPOJ1_ROI" 
[139] "L_TPOJ2_ROI"  "L_TPOJ3_ROI"  "L_DVT_ROI"    "L_PGp_ROI"    "L_IP2_ROI"    "L_IP1_ROI"   
[145] "L_IP0_ROI"    "L_PFop_ROI"   "L_PF_ROI"     "L_PFm_ROI"    "L_PGi_ROI"    "L_PGs_ROI"   
[151] "L_V6A_ROI"    "L_VMV1_ROI"   "L_VMV3_ROI"   "L_PHA2_ROI"   "L_V4t_ROI"    "L_FST_ROI"   
[157] "L_V3CD_ROI"   "L_LO3_ROI"    "L_VMV2_ROI"   "L_31pd_ROI"   "L_31a_ROI"    "L_VVC_ROI"   
[163] "L_25_ROI"     "L_s32_ROI"    "L_pOFC_ROI"   "L_PoI1_ROI"   "L_Ig_ROI"     "L_FOP5_ROI"  
[169] "L_p10p_ROI"   "L_p47r_ROI"   "L_TGv_ROI"    "L_MBelt_ROI"  "L_LBelt_ROI"  "L_A4_ROI"    
[175] "L_STSva_ROI"  "L_TE1m_ROI"   "L_PI_ROI"     "L_a32pr_ROI"  "L_p24_ROI"    "R_V1_ROI"    
[181] "R_MST_ROI"    "R_V6_ROI"     "R_V2_ROI"     "R_V3_ROI"     "R_V4_ROI"     "R_V8_ROI"    
[187] "R_4_ROI"      "R_3b_ROI"     "R_FEF_ROI"    "R_PEF_ROI"    "R_55b_ROI"    "R_V3A_ROI"   
[193] "R_RSC_ROI"    "R_POS2_ROI"   "R_V7_ROI"     "R_IPS1_ROI"   "R_FFC_ROI"    "R_V3B_ROI"   
[199] "R_LO1_ROI"    "R_LO2_ROI"    "R_PIT_ROI"    "R_MT_ROI"     "R_A1_ROI"     "R_PSL_ROI"   
[205] "R_SFL_ROI"    "R_PCV_ROI"    "R_STV_ROI"    "R_7Pm_ROI"    "R_7m_ROI"     "R_POS1_ROI"  
[211] "R_23d_ROI"    "R_v23ab_ROI"  "R_d23ab_ROI"  "R_31pv_ROI"   "R_5m_ROI"     "R_5mv_ROI"   
[217] "R_23c_ROI"    "R_5L_ROI"     "R_24dd_ROI"   "R_24dv_ROI"   "R_7AL_ROI"    "R_SCEF_ROI"  
[223] "R_6ma_ROI"    "R_7Am_ROI"    "R_7PL_ROI"    "R_7PC_ROI"    "R_LIPv_ROI"   "R_VIP_ROI"   
[229] "R_MIP_ROI"    "R_1_ROI"      "R_2_ROI"      "R_3a_ROI"     "R_6d_ROI"     "R_6mp_ROI"   
[235] "R_6v_ROI"     "R_p24pr_ROI"  "R_33pr_ROI"   "R_a24pr_ROI"  "R_p32pr_ROI"  "R_a24_ROI"   
[241] "R_d32_ROI"    "R_8BM_ROI"    "R_p32_ROI"    "R_10r_ROI"    "R_47m_ROI"    "R_8Av_ROI"   
[247] "R_8Ad_ROI"    "R_9m_ROI"     "R_8BL_ROI"    "R_9p_ROI"     "R_10d_ROI"    "R_8C_ROI"    
[253] "R_44_ROI"     "R_45_ROI"     "R_47l_ROI"    "R_a47r_ROI"   "R_6r_ROI"     "R_IFJa_ROI"  
[259] "R_IFJp_ROI"   "R_IFSp_ROI"   "R_IFSa_ROI"   "R_p9-46v_ROI" "R_46_ROI"     "R_a9-46v_ROI"
[265] "R_9-46d_ROI"  "R_9a_ROI"     "R_10v_ROI"    "R_a10p_ROI"   "R_10pp_ROI"   "R_11l_ROI"   
[271] "R_13l_ROI"    "R_OFC_ROI"    "R_47s_ROI"    "R_LIPd_ROI"   "R_6a_ROI"     "R_i6-8_ROI"  
[277] "R_s6-8_ROI"   "R_43_ROI"     "R_OP4_ROI"    "R_OP1_ROI"    "R_OP2-3_ROI"  "R_52_ROI"    
[283] "R_RI_ROI"     "R_PFcm_ROI"   "R_PoI2_ROI"   "R_TA2_ROI"    "R_FOP4_ROI"   "R_MI_ROI"    
[289] "R_Pir_ROI"    "R_AVI_ROI"    "R_AAIC_ROI"   "R_FOP1_ROI"   "R_FOP3_ROI"   "R_FOP2_ROI"  
[295] "R_PFt_ROI"    "R_AIP_ROI"    "R_EC_ROI"     "R_PreS_ROI"   "R_ProS_ROI"   "R_PeEc_ROI"  
[301] "R_STGa_ROI"   "R_PBelt_ROI"  "R_A5_ROI"     "R_PHA1_ROI"   "R_PHA3_ROI"   "R_STSda_ROI" 
[307] "R_STSdp_ROI"  "R_STSvp_ROI"  "R_TGd_ROI"    "R_TE1a_ROI"   "R_TE1p_ROI"   "R_TE2a_ROI"  
[313] "R_TF_ROI"     "R_TE2p_ROI"   "R_PHT_ROI"    "R_PH_ROI"     "R_TPOJ1_ROI"  "R_TPOJ2_ROI" 
[319] "R_TPOJ3_ROI"  "R_DVT_ROI"    "R_PGp_ROI"    "R_IP2_ROI"    "R_IP1_ROI"    "R_IP0_ROI"   
[325] "R_PFop_ROI"   "R_PF_ROI"     "R_PFm_ROI"    "R_PGi_ROI"    "R_PGs_ROI"    "R_V6A_ROI"   
[331] "R_VMV1_ROI"   "R_VMV3_ROI"   "R_PHA2_ROI"   "R_V4t_ROI"    "R_FST_ROI"    "R_V3CD_ROI"  
[337] "R_LO3_ROI"    "R_VMV2_ROI"   "R_31pd_ROI"   "R_31a_ROI"    "R_VVC_ROI"    "R_25_ROI"    
[343] "R_s32_ROI"    "R_pOFC_ROI"   "R_PoI1_ROI"   "R_Ig_ROI"     "R_FOP5_ROI"   "R_p10p_ROI"  
[349] "R_p47r_ROI"   "R_TGv_ROI"    "R_MBelt_ROI"  "R_LBelt_ROI"  "R_A4_ROI"     "R_STSva_ROI" 
[355] "R_TE1m_ROI"   "R_PI_ROI"     "R_a32pr_ROI"  "R_p24_ROI"   
# Source Data
fig3bSD <- 
  ROI_Gcosinor |>
  # GM with any(qvalue<0.05)
  filter(measure %in% c("cbf","gm_md","qt1")) |>
  mutate(acro=ifelse(qvalue<0.05,acrophase,NA)) |> 
  select(measure,roi,acro)
write_csv(fig3bSD |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_3b_part1.csv")

# GM-MD and GM-qT1 are reordered in post
spatial_p <-
  inner_join(fig3bSD,meta) |> 
  ungroup() |>
  ggplot(aes(fill=acro))+
  facet_wrap(~int2extlab[measure],nrow=5)+
  theme_condense()+
  scale_fill_clock(rot=15,na.value="grey95")+
  geom_brain(atlas = glasser,
             position=position_brain(side ~ hemi),
             color="grey",size=0.1)+
  theme_void() 
spatial_p

Subcortical

myaseg <- get_subcor_ggseg_atlas()
spatial_subcort_p <- fig3bSD |>  
    rename(label=roi) |> 
    ungroup() |> 
    select(label,acro,measure) |> 
    ggplot(aes(fill=acro))+
    theme_condense()+
    scale_fill_clock(rot=15,na.value="grey95")+
    facet_wrap(~int2extlab[measure],nrow=3)+
    geom_brain(atlas = myaseg)+
    theme_void()
spatial_subcort_p

ICBM (WM-MD)

To be added manually to final figure

library(ggsegICBM)
library(plotly)
library(ggseg3d)
meta <- get_icbm_spatial_meta()
pdf <- ROI_Gcosinor |> filter(measure=="md") 

# Source Data
fig3bSD2 <- 
  pdf |> 
  mutate(acro=ifelse(qvalue<0.05,acrophase,NA)) |> 
  select(measure,roi,acro)
write_csv(fig3bSD2 |> mutate(measure=int2extlab[measure]),
          "output/source_data/Figure_3b_part2.csv")

pdf2 <- inner_join(fig3bSD2,meta) |> icbm_preprocess()
pdf2$region %in% icbm_3d$ggseg_3d[[1]]$region
 [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[21] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[41] TRUE TRUE TRUE TRUE TRUE
rot=15
pal <- 1:24
names(pal) <- rainbow(24)[((1:24)-1+rot)%%24+1]


p3d <-  
  pdf2 |> 
  select(measure,acro,roi,region) |> 
    ggseg3d(atlas = icbm_3d,colour="acro",
            palette = pal,na.alpha = 0.01) |> 
    add_glassbrain(opacity=0.05) |>
    pan_camera("right lateral") |>
    remove_axes()
p3d
pdf2 |>     
    select(region,acro,roi) |> 
    ggseg3d(atlas = icbm_3d,colour="acro",
            palette = pal,na.alpha = 0.01) |> 
    add_glassbrain(opacity=0.05) |>
    pan_camera("left lateral") |>
    remove_axes()

Color legend

circcols_p <-
    predat |> 
    ggplot()+
    geom_rect(xmin=-1,xmax=25,ymin=-1,ymax=0,fill="white",color=NA)+
    coord_polar()+
    scale_y_continuous(limits = c(-1,NA))+
    scale_x_continuous(limits=c(0,24),breaks=seq(0,24,3))+
    xlab("ROI Population-Mean Acrophase")+
    ylab("")+
    theme_minimal()+theme_condense()+
    theme(
        panel.grid.minor.x = element_blank(),
          panel.grid.minor.y = element_blank(),
          panel.grid.major.y = element_blank(),
          panel.grid.major.x = element_blank()
        )+
    theme(axis.text.x = element_text(size=6),
          axis.text.y = element_blank())+
    geom_tile(data=data.frame(ymax=rep(2,200),
                              x=c(seq(0,24,length.out=200))),
              aes(x,y=ymax, fill = x),
              color=NA,alpha=0.9) +
    scale_fill_clock(rot=15,guide="none")
circcols_p

Figure 3

Figure 3

theme_condense <- function(){
    list(
        theme(strip.background = element_rect(color='white',fill='white')),
        theme(strip.text = element_text(size=6,color="black",
                                        margin = margin( b = 0, t = 0) ) ),
        theme(axis.text = element_text(size=6))
        )
}

library(patchwork)
library(ggpubr)
f3a_sub_act_ss +ggtitle("a")+theme(strip.text = element_blank())+
    #
    rhosum_ss_p+theme_minimal()+theme_condense()+theme(axis.text.x = element_text())+theme(strip.text = element_blank())+
    geom_hline(yintercept = c(0,1),color="grey80")+
    theme(axis.text.y = element_blank())+
    #
    spatial_p + theme(legend.position = "none")+ggtitle("b")+theme(strip.text = element_blank())+
    #
    gcrose_ss_p + theme(legend.position = 'none')+theme_condense()+ ggtitle("c")+
    theme(axis.text.y = element_text(size=6))+theme(strip.text = element_text(size=14,color="black"))+
    #
    as_ggplot(get_legend(gcrose_ss_p))+
    circcols_p+
    # annotate("text",0,-0.7,label="Population-Mean Acrophase")+
    #patchwork
    plot_layout(design = "
                AAABCCCCCDDDD
                AAABCCCCCDDDD
                AAABCCCCCDDDD
                AAABEEEEEDDDD
                ####FFFFF####
                ")+
    # plot_annotation(tag_levels = 'a')+
    plot_layout(guides = 'collect')

Figure S2 (Rest of 3)

library(patchwork)
f3a_sub_act + theme_condense()+
  rhosum_p +theme_condense()+
  theme(axis.text.y = element_text(size=6))+
  p_roiact +  theme_condense()+
    gcrose_p + theme_condense()+
    #patchwork
    plot_layout(design = "AABBCCDD")+
    plot_annotation(tag_levels = 'a')+
    plot_layout(guides = 'collect')


Click to see page metadata

Computation Started: 2023-10-11 19:57:12

Finished in 2.499 mins


Git Log

No git history available for this page


Packages

package version date
readxl 1.4.1 2023-10-10
backports 1.4.1 2023-10-10
systemfonts 1.0.4 2023-10-10
plyr 1.8.8 2023-10-10
lazyeval 0.2.2 2023-10-10
shinydashboard 0.7.2 2023-10-10
crosstalk 1.2.0 2023-10-10
GenomeInfoDb 1.30.1 2023-10-10
ggplot2 3.4.0 2023-10-10
digest 0.6.31 2023-10-10
foreach 1.5.2 2023-10-10
ca 0.71.1 2023-10-10
htmltools 0.5.4 2023-10-10
viridis 0.6.2 2023-10-10
magick 2.7.3 2023-10-10
fansi 1.0.4 2023-10-10
magrittr 2.0.3 2023-10-10
googlesheets4 1.0.1 2023-10-10
tzdb 0.3.0 2023-10-10
readr 2.1.3 2023-10-10
modelr 0.1.10 2023-10-10
matrixStats 0.63.0 2023-10-10
vroom 1.6.1 2023-10-10
methods 4.1.3 2023-06-16
svglite 2.1.1 2023-10-10
timechange 0.2.0 2023-10-10
colorspace 2.1-0 2023-10-10
rvest 1.0.3 2023-10-10
ggsegGlasser 1.0.01 2023-10-10
haven 2.5.1 2023-10-10
xfun 0.37 2023-10-10
dplyr 1.1.0 2023-10-10
crayon 1.5.2 2023-10-10
RCurl 1.98-1.10 2023-10-10
jsonlite 1.8.4 2023-10-10
iterators 1.0.14 2023-10-10
glue 1.6.2 2023-10-10
ggsegICBM 1.0.1 2023-10-10
kableExtra 1.3.4 2023-10-10
registry 0.5-1 2023-10-10
utils 4.1.3 2023-06-16
gtable 0.3.1 2023-10-10
gargle 1.3.0 2023-10-10
zlibbioc 1.40.0 2023-10-10
XVector 0.34.0 2023-10-10
webshot 0.5.4 2023-10-10
UpSetR 1.4.0 2023-10-10
DelayedArray 0.20.0 2023-10-10
car 3.1-2 2023-10-10
BiocGenerics 0.40.0 2023-10-10
abind 1.4-5 2023-10-10
scales 1.2.1 2023-10-10
futile.options 1.0.1 2023-10-10
DBI 1.1.3 2023-10-10
graphics 4.1.3 2023-06-16
rstatix 0.7.2 2023-10-10
miniUI 0.1.1.1 2023-10-10
Rcpp 1.0.10 2023-10-10
viridisLite 0.4.1 2023-10-10
xtable 1.8-4 2023-10-10
units 0.8-2 2023-10-10
proxy 0.4-27 2023-10-10
bit 4.0.5 2023-10-10
stats4 4.1.3 2023-06-16
DT 0.27 2023-10-10
base 4.1.3 2023-06-16
htmlwidgets 1.6.1 2023-10-10
httr 1.4.4 2023-10-10
RColorBrewer 1.1-3 2023-10-10
ellipsis 0.3.2 2023-10-10
pkgconfig 2.0.3 2023-10-10
farver 2.1.1 2023-10-10
dbplyr 2.3.0 2023-10-10
utf8 1.2.3 2023-10-10
here 1.0.1 2023-10-10
labeling 0.4.2 2023-10-10
tidyselect 1.2.0 2023-10-10
rlang 1.0.6 2023-10-10
reshape2 1.4.4 2023-10-10
later 1.3.0 2023-10-10
stats 4.1.3 2023-06-16
munsell 0.5.0 2023-10-10
cellranger 1.1.0 2023-10-10
tools 4.1.3 2023-06-16
cli 3.6.0 2023-10-10
generics 0.1.3 2023-10-10
broom 1.0.3 2023-10-10
evaluate 0.20 2023-10-10
shinyBS 0.61.1 2023-10-10
stringr 1.5.0 2023-10-10
fastmap 1.1.0 2023-10-10
heatmaply 1.4.2 2023-10-10
yaml 2.3.7 2023-10-10
grDevices 4.1.3 2023-06-16
bit64 4.0.5 2023-10-10
knitr 1.42 2023-10-10
fs 1.6.1 2023-10-10
shinycssloaders 1.0.0 2023-10-10
zip 2.2.2 2023-10-10
purrr 1.0.1 2023-10-10
dendextend 1.16.0 2023-10-10
DiscoRhythm 1.10.1 2023-10-10
mime 0.12 2023-10-10
formatR 1.14 2023-10-10
ggExtra 0.10.0 2023-10-10
xml2 1.3.3 2023-10-10
BiocStyle 2.22.0 2023-10-10
compiler 4.1.3 2023-06-16
rstudioapi 0.14 2023-10-10
plotly 4.10.1 2023-10-10
ggsignif 0.6.4 2023-10-10
e1071 1.7-13 2023-10-10
reprex 2.0.2 2023-10-10
tibble 3.1.8 2023-10-10
stringi 1.7.12 2023-10-10
highr 0.10 2023-10-10
futile.logger 1.4.3 2023-10-10
forcats 1.0.0 2023-10-10
lattice 0.20-45 2023-06-16
Matrix 1.5-1 2023-10-10
classInt 0.4-9 2023-10-10
shinyjs 2.1.0 2023-10-10
vctrs 0.5.2 2023-10-10
ggseg3d 1.6.3 2023-10-10
pillar 1.8.1 2023-10-10
lifecycle 1.0.3 2023-10-10
BiocManager 1.30.19 2023-10-10
cowplot 1.1.1 2023-10-10
data.table 1.14.6 2023-10-10
bitops 1.0-7 2023-10-10
seriation 1.4.1 2023-10-10
httpuv 1.6.8 2023-10-10
patchwork 1.1.2 2023-10-10
GenomicRanges 1.46.1 2023-10-10
R6 2.5.1 2023-10-10
promises 1.2.0.1 2023-10-10
TSP 1.2-2 2023-10-10
renv 0.17.3 2023-10-11
KernSmooth 2.23-20 2023-06-16
gridExtra 2.3 2023-10-10
IRanges 2.28.0 2023-10-10
codetools 0.2-19 2023-10-10
lambda.r 1.2.4 2023-10-10
assertthat 0.2.1 2023-10-10
SummarizedExperiment 1.24.0 2023-10-10
rprojroot 2.0.3 2023-10-10
withr 2.5.0 2023-10-10
S4Vectors 0.32.4 2023-10-10
datasets 4.1.3 2023-06-16
GenomeInfoDbData 1.2.7 2023-10-10
parallel 4.1.3 2023-06-16
hms 1.1.2 2023-10-10
VennDiagram 1.7.3 2023-10-10
grid 4.1.3 2023-06-16
tidyverse 1.3.2 2023-10-10
class 7.3-21 2023-10-10
tidyr 1.3.0 2023-10-10
rmarkdown 2.20 2023-10-10
carData 3.0-5 2023-10-10
MatrixGenerics 1.6.0 2023-10-10
googledrive 2.0.0 2023-10-10
git2r 0.31.0 2023-10-10
ggpubr 0.6.0 2023-10-10
sf 1.0-12 2023-10-10
ggseg 1.6.6 2023-10-10
Biobase 2.54.0 2023-10-10
shiny 1.7.4 2023-10-10
lubridate 1.9.1 2023-10-10

System Information

systemInfo
version R version 4.1.3 (2022-03-10)
platform x86_64-pc-linux-gnu (64-bit)
locale en_US.UTF-8
OS Ubuntu 20.04.6 LTS
UI X11

Scikick Configuration

cat scikick.yml
### Scikick Project Workflow Configuration File

# Directory where Scikick will store all standard notebook outputs
reportdir: report

# --- Content below here is best modified by using the Scikick CLI ---

# Notebook Execution Configuration (format summarized below)
# analysis:
#  first_notebook.Rmd:
#  second_notebook.Rmd:
#  - first_notebook.Rmd         # must execute before second_notebook.Rmd
#  - functions.R                # file is used by second_notebook.Rmd
#
# Each analysis item is executed to generate md and html files, E.g.:
# 1. <reportdir>/out_md/first_notebook.md
# 2. <reportdir>/out_html/first_notebook.html

analysis: !!omap
- code/methods/methods_walkthrough.Rmd:
- code/methods/Gcosinor_implementation_check.Rmd: []
- code/results/WB_S-cosinor.Rmd: []
- code/results/WB_G-cosinor.Rmd:
  - code/results/WB_S-cosinor.Rmd
- code/results/WB_acrophase_agnostic_tests.Rmd:
  - code/results/WB_S-cosinor.Rmd
- code/results/ROI_S-cosinor.Rmd: []
- code/results/ROI_G-cosinor.Rmd:
  - code/results/ROI_S-cosinor.Rmd
- code/results/ROI_acrophase_agnostic_tests.Rmd:
  - code/results/ROI_S-cosinor.Rmd
- code/results/body_weight.Rmd: []
- code/results/WB_cosinor_stats_BPD.Rmd: []
- code/results/ROI_cosinor_stats_BPD.Rmd: []
- code/results/WB_BPD_diffs.Rmd:
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_S-cosinor.Rmd
- code/display_items/table_1.Rmd:
  - code/display_items/figure_S5_actigraphy.Rmd
  - code/results/body_weight.Rmd
- code/display_items/table_2.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/body_weight.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/ROI_acrophase_agnostic_tests.Rmd
- code/display_items/figure_2.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/body_weight.Rmd
- code/display_items/figure_3.Rmd:
  - code/results/ROI_S-cosinor.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/WB_G-cosinor.Rmd
- code/display_items/figure_4.Rmd:
  - code/results/WB_G-cosinor.Rmd
  - code/results/WB_acrophase_agnostic_tests.Rmd
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_BPD_diffs.Rmd
  - code/results/ROI_cosinor_stats_BPD.Rmd
  - code/results/ROI_G-cosinor.Rmd
  - code/results/ROI_acrophase_agnostic_tests.Rmd
- code/display_items/table_S1_techvar.Rmd:
- code/display_items/table_S3_adjweight.Rmd: []
- code/display_items/figure_S4_spatialG.Rmd:
  - code/results/ROI_G-cosinor.Rmd
- code/display_items/figure_S5_actigraphy.Rmd: []
- code/display_items/figure_S6_phasePSQI.Rmd:
  - code/results/WB_cosinor_stats_BPD.Rmd
  - code/results/WB_S-cosinor.Rmd
- code/index.Rmd:
  - README.md
snakefile_args:
  singularity: /external/EPIGENETICS/SCRATCH/automator/share/singularity/shared3.img
version_info:
  snakemake: 6.3.0
  ruamel.yaml: 0.16.5
  scikick: 0.2.0
# Optional site theme customization
output:
  BiocStyle::html_document:
    code_folding: show
    theme: readable
    toc_float: true
    toc: true
    number_sections: false
    toc_depth: 5
    self_contained: true

Functions

acro2complex

function (acro, per = 24) 
{
    z <- complex(real = cos(acro/per * 2 * pi), imaginary = sin(acro/per * 
        2 * pi))
    return(z)
}
<bytecode: 0x5651cad8a1c0>

ampacro2cos

function (amp, acro, per = 24) 
amp * cos(acro/per * 2 * pi)

ampacro2sin

function (amp, acro, per = 24) 
amp * sin(acro/per * 2 * pi)

circamean

function (x, ...) 
{
    ret <- {
        function(x) (x * 24/(2 * pi))%%24
    }(Arg(mean(acro2complex(x))))
    return(ret)
}

circdist

function (acro1, acro2, per = 24) 
{
    tmp <- (acro1 - acro2)%%per
    idx <- which(tmp > (per/2))
    tmp[idx] <- tmp[idx] - per
    return(tmp)
}
<bytecode: 0x5651d4633d58>

coord_circpolar

function (...) 
{
    list(coord_polar(...), scale_x_continuous(limits = c(0, 24), 
        breaks = seq(0, 24, 3)), scale_y_continuous(limits = c(-1, 
        NA)), theme(panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank(), 
        panel.grid.major.x = element_blank()), geom_hline(yintercept = 0, 
        color = "grey"))
}

cosinor_pred

function (time, A, acro, mesor = 0, per = 24) 
{
    mesor + A * cos((time - acro) * 2 * pi/per)
}

dcast

function (data, formula, fun.aggregate = NULL, ..., margins = NULL, 
    subset = NULL, fill = NULL, drop = TRUE, value.var = guess_value(data)) 
{
    formula <- parse_formula(formula, names(data), value.var)
    if (length(formula) > 2) {
        stop("Dataframes have at most two output dimensions")
    }
    if (!is.null(margins)) {
        data <- add_margins(data, lapply(formula, names), margins)
    }
    res <- cast(data, formula, fun.aggregate, ..., subset = subset, 
        fill = fill, drop = drop, value.var = value.var)
    data <- as.data.frame.matrix(res$data, stringsAsFactors = FALSE)
    names(data) <- array_names(res$labels[[2]])
    stopifnot(nrow(res$labels[[1]]) == nrow(data))
    cbind(res$labels[[1]], data)
}
<bytecode: 0x5651b88bff68>
<environment: namespace:reshape2>

discoCosinor

function (x, zts, per = 24) 
{
    Y <- as.matrix(x)
    res <- lmCSmatNoNA(Y[NULL, ], zts, per)
    res[seq_len(nrow(Y)), ] <- NA
    obsinds <- t(!is.na(Y))
    obstypes <- unique(obsinds, MARGIN = 2)
    obstypes <- obstypes[, colSums(obstypes) > 2, drop = FALSE]
    for (i in seq_len(ncol(obstypes))) {
        inds <- colMeans(obsinds == obstypes[, i]) == 1
        res[inds, ] <- lmCSmatNoNA(Y[inds, obstypes[, i], drop = FALSE], 
            zts[obstypes[, i]], per)
    }
    res
}
<bytecode: 0x5651c9053fa0>
<environment: namespace:DiscoRhythm>

discoPMcos

function (x, period = 24, idname = NULL, alpha = 0.05) 
{
    if (is.data.frame(x)) 
        x <- split(x, 1:nrow(x))
    isdup <- F
    if (nrow(x[[1]]) == 1) {
        isdup <- T
        x <- lapply(x, function(y) rbind(y, y))
    }
    betas <- sapply(x, function(a) a$sincoef)
    gammas <- sapply(x, function(a) a$coscoef)
    mesors <- sapply(x, function(a) a$mesor)
    beta <- rowMeans(betas)
    gamma <- rowMeans(gammas)
    MESOR <- rowMeans(mesors)
    amplitude <- sqrt(beta^2 + gamma^2)
    acrophase_rad <- atan2(beta, gamma)
    sdm <- matrixStats::rowSds(mesors)
    sdb <- matrixStats::rowSds(betas)
    sdy <- matrixStats::rowSds(gammas)
    covby <- diag(cov(t(betas), t(gammas)))
    k <- ncol(betas)
    denom <- amplitude^2 * k
    c22 <- (sdb^2 * beta^2 + 2 * covby * beta * gamma + sdy^2 * 
        gamma^2)/denom
    c23 <- ((-1 * (sdb^2 - sdy^2)) * (beta * gamma) + covby * 
        (beta^2 - gamma^2))/denom
    c33 <- (sdb^2 * gamma^2 - 2 * covby * beta * gamma + sdy^2 * 
        beta^2)/denom
    t <- abs(qt(alpha/2, df = k - 1))
    mesoru <- MESOR + ((t * sdm)/sqrt(k))
    mesorl <- MESOR - ((t * sdm)/sqrt(k))
    ampu <- amplitude + (t * sqrt(c22))
    ampl <- amplitude - (t * sqrt(c22))
    tmp <- vapply(seq_along(ampu), function(i) {
        if (ampu[i] > 0 & ampl[i] < 0) {
            return(c(NA, NA))
        }
        dn <- amplitude[i]^2 - c22[i] * t^2
        crit <- t * sqrt(c33[i]) * sqrt(amplitude[i]^2 - (c22[i] * 
            c33[i] - c23[i]^2) * (t^2/c33[i]))
        return(c(acrophase_rad[i] + atan((c23[i] * t^2 + crit)/dn), 
            acrophase_rad[i] + atan((c23[i] * t^2 - crit)/dn)))
    }, numeric(2))
    fiu <- tmp[1, ]
    fil <- tmp[2, ]
    r <- diag(cor(t(betas), t(gammas)))
    frac1 <- (k * (k - 2))/(2 * (k - 1))
    frac2 <- 1/(1 - r^2)
    frac3 <- beta^2/sdb^2
    frac4 <- (beta * gamma)/(sdb * sdy)
    frac5 <- gamma^2/sdy^2
    brack <- frac3 - 2 * r * frac4 + frac5
    Fvalue <- frac1 * frac2 * brack
    df2 <- k - 2
    pvalue <- pf(q = Fvalue, df1 = 2, df2 = df2, lower.tail = F)
    ret <- data.frame(F = Fvalue, df1 = 2, df2 = k - 2, pvalue, 
        qvalue = p.adjust(pvalue, "fdr"), MESOR, amplitude = amplitude, 
        acrophase = (acrophase_rad/2/pi * period + period)%%period, 
        MESOR_l = mesorl, MESOR_u = mesoru, amp_l = ampl, amp_u = ampu, 
        acro_l = (fil/2/pi * period + period)%%period, acro_u = (fiu/2/pi * 
            period + period)%%period)
    idx <- which(ret$acro_l > ret$acro_u)
    ret$acro_l[idx] <- ret$acro_l[idx] - period
    idx <- which((ret$acro_l < ret$acro & ret$acro_u < ret$acro))
    ret$acro_l[idx] <- ret$acro_l[idx] + period
    ret$acro_u[idx] <- ret$acro_u[idx] + period
    idx <- which((ret$acro_l > ret$acro & ret$acro_u > ret$acro))
    ret$acro_l[idx] <- ret$acro_l[idx] - period
    ret$acro_u[idx] <- ret$acro_u[idx] - period
    if (!is.null(idname)) {
        rownames(ret) <- x[[1]][[idname]]
    }
    else {
        rownames(ret) <- rownames(x[[1]])
    }
    if (isdup) 
        ret <- ret[1, ]
    return(ret)
}

dx2lab

function (x) 
{
    return(ifelse(as.character(x) == "1", "BPD", "CNTRL"))
}

geom_smooth_cosinor

function (...) 
geom_smooth(method = "lm", formula = y ~ sinpi(x/12) + cospi(x/12), 
    ...)

get_glasser_spatial_meta

function () 
{
    meta <- readxl::read_xlsx("data/reference_files/MMP1_CSV_file.xlsx")
    meta <- meta %>% mutate(region = ifelse(region == "7Pl", 
        "7PL", region)) %>% mutate(regionName = ifelse(regionName == 
        "7Pl_L", "7PL_L", regionName)) %>% mutate(regionName = ifelse(regionName == 
        "7Pl_R", "7PL_R", regionName))
    meta$roi <- paste(meta$LR, gsub("_[LR]", "", meta$regionName), 
        "ROI", sep = "_")
    meta$hemi <- ifelse(meta$LR == "L", "left", "right")
    return(meta)
}
<bytecode: 0x5651d98e2238>

get_icbm_spatial_meta

function () 
{
    meta <- readxl::read_xlsx("data/reference_files/JHU_ICBM81.xlsx")
    meta <- meta[-c(1:2), ]
    meta$region <- meta$label %>% gsub(" ", "_", .) %>% gsub("\\(", 
        "", .) %>% gsub("\\)", "", .) %>% gsub("\\/", "or", .)
    meta$roi <- meta$region
    meta <- meta %>% mutate(region = gsub(" R$", "", label)) %>% 
        mutate(region = gsub(" L$", "", region)) %>% filter(region != 
        "Unclassified")
    return(meta)
}
<bytecode: 0x5651d24ebf90>

get_subcor_ggseg_atlas

function () 
{
    library(ggseg)
    library(ggsegGlasser)
    meta <- get_glasser_spatial_meta()
    pdf <- full_join(unique(select(read_csv("data/available_upon_request/processed_ROI_data.csv") %>% 
        filter(measure == "cbf"), roi)), meta) %>% filter(is.na(`z-cog`)) %>% 
        rename(label = roi) %>% ungroup() %>% select(label)
    myaseg <- aseg
    myaseg$data <- myaseg$data %>% filter(label %in% pdf$label)
    return(myaseg)
}
<bytecode: 0x5651d4312b00>

groupWiseSummaryPvalTable

function (dat, as_kable = FALSE) 
{
    ret <- dat %>% group_by(grp) %>% summarize(res = list(summaryPvalTable(pvalue))) %>% 
        unnest(res) %>% mutate(val = paste0(percent, " (", count, 
        ")")) %>% reshape2::dcast(level ~ grp, value.var = "val")
    if (as_kable) 
        ret <- knitr::kable(ret)
    return(ret)
}

icbm_preprocess

function (df) 
{
    df %>% filter(region != "Fornix (column and body of fornix)") %>% 
        mutate(roi = str_pad(index, 3, pad = "0"))
}

my_val_formatter

function (x, doparse = T, mf = T, ...) 
{
    ifelse(x > 10000 | (x > 0 & x < 0.001) | (x < 0 & x > -0.001), 
        {
            txt1 <- (scales::scientific_format(digits = 2))(x)
            if (mf) {
                txt <- gsub("e\\+*", " %*% 10^", txt1)
            }
            else {
                return(txt1)
            }
            if (doparse) {
                return(parse(text = txt))
            }
            else {
                return(txt)
            }
        }, formatC(x, format = "fg", digits = 2, flag = "#", 
            big.mark = ","))
}

myfmt

function (x) 
formatC(x, digits = 2)

myfmt2

function (x) 
my_val_formatter(x, mf = F)

night_rect

function () 
{
    annotate(geom = "rect", ymin = -Inf, ymax = Inf, xmin = 24, 
        xmax = 32, alpha = 0.8, fill = "grey", color = NA)
}

night_rect_early

function () 
{
    annotate(geom = "rect", ymin = -Inf, ymax = Inf, xmin = 0, 
        xmax = 8, alpha = 0.8, fill = "grey", color = NA)
}
<bytecode: 0x5651d3926fd8>

night_recty

function () 
{
    annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = 24, 
        ymax = 32, alpha = 0.8, fill = "grey", color = NA)
}
<bytecode: 0x5651d8725550>

night_recty_early

function () 
{
    annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = 0, 
        ymax = 8, alpha = 0.8, fill = "grey", color = NA)
}
<bytecode: 0x5651d889b448>

pqlabs

function (p = NULL, q = NULL) 
{
    if (!is.null(p) & is.null(q)) {
        lab <- rep("p>0.05", length(p))
        lab[p < 0.05] <- "p<0.05"
        levs <- c("p>0.05", "p<0.05")
    }
    else if (is.null(p) & !is.null(q)) {
        lab <- rep("q>0.05", length(q))
        lab[q < 0.05] <- "q<0.05"
        levs <- c("q>0.05", "q<0.05")
    }
    else if (!is.null(p) & !is.null(q)) {
        stopifnot(length(p) == length(q))
        lab <- rep("p>0.05", length(p))
        lab[p < 0.05] <- "p<0.05"
        lab[q < 0.05] <- "q<0.05"
        levs <- c("p>0.05", "p<0.05", "q<0.05")
    }
    return(factor(lab, levels = levs))
}

rsqGcos

function (pmr, dat) 
{
    predat2 <- group_by(mutate(group_by(inner_join(pmr, dat), 
        measure, roi, subject), dmval = value - mean(value)), 
        measure, roi)
    rsqdf <- summarize(mutate(mutate(mutate(mutate(predat2, sr1 = (value - 
        cosinor_pred(time, amplitude, acrophase, MESOR))^2), 
        ts1 = (value - MESOR)^2), sr2 = (dmval - cosinor_pred(time, 
        amplitude, acrophase, 0))^2), ts2 = (dmval - 0)^2), rsq = 1 - 
        sum(sr1)/sum(ts1), rsqdm = 1 - sum(sr2)/sum(ts2))
    return(inner_join(pmr, rsqdf))
}

scale_alpha_fgbg

function (alpha_bg = 0.3, ...) 
scale_alpha_manual(values = c(`TRUE` = 1, `FALSE` = alpha_bg, 
    ...))

scale_color_clock

function (rot = 0, ...) 
scale_color_gradientn(colors = rainbow(24)[((1:24) - 1 + rot)%%24 + 
    1], limits = c(0, 24), ...)

scale_color_dx

function () 
{
    scale_color_manual(values = c(`1` = colors$dx1, `0` = colors$dx0))
}

scale_color_dxlab

function (...) 
{
    scale_color_manual(values = c(BPD = colors$dx1, CNTRL = colors$dx0, 
        ...))
}

scale_color_fgbg

function (fgcol = "red", ...) 
scale_color_manual(values = c(`TRUE` = fgcol, `FALSE` = "grey20", 
    ...))

scale_fill_clock

function (rot = 0, ...) 
scale_fill_gradientn(colors = rainbow(24)[((1:24) - 1 + rot)%%24 + 
    1], limits = c(0, 24), ...)
<bytecode: 0x5651e3e3e288>

scale_fill_dx

function () 
{
    scale_fill_manual(values = c(`1` = colors$dx1, `0` = colors$dx0))
}

scale_fill_dxlab

function () 
{
    scale_fill_manual(values = c(BPD = colors$dx1, CNTRL = colors$dx0))
}

scale_fill_fgbg

function (fgcol = "red", ...) 
scale_fill_manual(values = c(`TRUE` = fgcol, `FALSE` = "grey20", 
    ...))

scale_x_circ

function () 
scale_x_continuous(limits = c(0, 24), breaks = seq(0, 24, 6))

session_is_day2

function (session, time) 
{
    (session >= 6 & session <= 9) & time < 12
}

sincos2acro

function (sin, cos, per = 24) 
{
    (atan2(sin, cos)/2/pi * per + per)%%per
}
<bytecode: 0x5651c971c168>
<environment: namespace:DiscoRhythm>

sincos2amp

function (sin, cos) 
sqrt(sin^2 + cos^2)
<bytecode: 0x5651c9727650>
<environment: namespace:DiscoRhythm>

stat_smooth_cosinor

function (...) 
stat_smooth(geom = "line", method = "lm", formula = y ~ sinpi(x/12) + 
    cospi(x/12), ...)

summaryPvalTable

function (p, as_kable = FALSE) 
{
    ps <- list()
    ps[[1]] <- p < 0.05
    ps[[2]] <- p < 0.01
    ps[[3]] <- p.adjust(p, method = "fdr") < 0.05
    ps[[4]] <- p.adjust(p, method = "bonferroni") < 0.05
    levs <- c("p < 0.05", "p < 0.01", "FDR", "Bonferroni")
    perc <- sapply(ps, function(p) round(mean(p, na.rm = TRUE), 
        4)) * 100
    sums <- sapply(ps, function(p) sum(p, na.rm = TRUE))
    ret <- data.frame(level = levs, count = sums, percent = paste0(perc, 
        "%"), stringsAsFactors = FALSE)
    if (as_kable) 
        ret <- knitr::kable(ret)
    return(ret)
}

theme_condense

function () 
{
    list(theme(strip.background = element_rect(color = "white", 
        fill = "white")), theme(strip.text = element_text(size = 7, 
        color = "black", margin = margin(b = 0, t = 0))), theme(axis.text = element_text(size = 7)))
}
<bytecode: 0x5651d1bc4598>

theme_condense_legend

function () 
{
    list(guides(shape = guide_legend(override.aes = list(size = 0.3))), 
        guides(color = guide_legend(override.aes = list(size = 0.3))), 
        guides(fill = guide_legend(override.aes = list(size = 0.3))), 
        theme(legend.title = element_text(size = 6), legend.text = element_text(size = 6), 
            legend.key.size = unit(0.3, "cm")))
}


Next (Project Map) skmap cluster_code/methods/ code/methods/ cluster_code/results/ code/results/ cluster_code/ code/ cluster_code/display_items/ code/display_items/ cluster_/ / code/results/body_weight.Rmd Body Weight code/display_items/table_1.Rmd Table 1 code/results/body_weight.Rmd->code/display_items/table_1.Rmd code/display_items/table_2.Rmd Table 2 code/results/body_weight.Rmd->code/display_items/table_2.Rmd code/display_items/figure_2.Rmd Figure 2 code/results/body_weight.Rmd->code/display_items/figure_2.Rmd code/results/WB_G-cosinor.Rmd WB G-cosinor code/results/WB_G-cosinor.Rmd->code/display_items/table_2.Rmd code/results/WB_G-cosinor.Rmd->code/display_items/figure_2.Rmd code/display_items/figure_3.Rmd Figure 3 code/results/WB_G-cosinor.Rmd->code/display_items/figure_3.Rmd code/display_items/figure_4.Rmd Figure 4 code/results/WB_G-cosinor.Rmd->code/display_items/figure_4.Rmd code/results/WB_acrophase_agnostic_tests.Rmd WB Acrophase Agnostic Tests code/results/WB_acrophase_agnostic_tests.Rmd->code/display_items/table_2.Rmd code/results/WB_acrophase_agnostic_tests.Rmd->code/display_items/figure_2.Rmd code/results/WB_acrophase_agnostic_tests.Rmd->code/display_items/figure_4.Rmd code/results/ROI_G-cosinor.Rmd ROI G-cosinor code/results/ROI_G-cosinor.Rmd->code/display_items/table_2.Rmd code/results/ROI_G-cosinor.Rmd->code/display_items/figure_3.Rmd code/results/ROI_G-cosinor.Rmd->code/display_items/figure_4.Rmd code/display_items/figure_S4_spatialG.Rmd Figure S4 SpatialG code/results/ROI_G-cosinor.Rmd->code/display_items/figure_S4_spatialG.Rmd code/results/ROI_acrophase_agnostic_tests.Rmd ROI Acrophase Agnostic Tests code/results/ROI_acrophase_agnostic_tests.Rmd->code/display_items/table_2.Rmd code/results/ROI_acrophase_agnostic_tests.Rmd->code/display_items/figure_4.Rmd code/results/ROI_S-cosinor.Rmd ROI S-cosinor code/results/ROI_S-cosinor.Rmd->code/results/ROI_G-cosinor.Rmd code/results/ROI_S-cosinor.Rmd->code/results/ROI_acrophase_agnostic_tests.Rmd code/results/ROI_S-cosinor.Rmd->code/display_items/figure_3.Rmd code/results/WB_cosinor_stats_BPD.Rmd WB Cosinor Stats BPD code/results/WB_cosinor_stats_BPD.Rmd->code/display_items/figure_4.Rmd code/results/WB_BPD_diffs.Rmd WB BPD Diffs code/results/WB_cosinor_stats_BPD.Rmd->code/results/WB_BPD_diffs.Rmd code/display_items/figure_S6_phasePSQI.Rmd Figure S6 PhasePSQI code/results/WB_cosinor_stats_BPD.Rmd->code/display_items/figure_S6_phasePSQI.Rmd code/results/WB_BPD_diffs.Rmd->code/display_items/figure_4.Rmd code/results/ROI_cosinor_stats_BPD.Rmd ROI Cosinor Stats BPD code/results/ROI_cosinor_stats_BPD.Rmd->code/display_items/figure_4.Rmd code/results/WB_S-cosinor.Rmd WB S-cosinor code/results/WB_S-cosinor.Rmd->code/results/WB_G-cosinor.Rmd code/results/WB_S-cosinor.Rmd->code/results/WB_acrophase_agnostic_tests.Rmd code/results/WB_S-cosinor.Rmd->code/results/WB_BPD_diffs.Rmd code/results/WB_S-cosinor.Rmd->code/display_items/figure_S6_phasePSQI.Rmd README.md README.md code/index.Rmd Index README.md->code/index.Rmd code/methods/methods_walkthrough.Rmd Methods Walkthrough code/methods/Gcosinor_implementation_check.Rmd Gcosinor Implementation Check code/display_items/figure_S5_actigraphy.Rmd Figure S5 Actigraphy code/display_items/figure_S5_actigraphy.Rmd->code/display_items/table_1.Rmd code/display_items/table_S1_techvar.Rmd Table S1 Techvar code/display_items/table_S3_adjweight.Rmd Table S3 Adjweight